perm filename PPK.FAI[HAK,HPM]11 blob
sn#373829 filedate 1978-08-15 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00011 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE PPK
C00004 00003 08/14/78 EJG *** bug below has supposedly been fixed ***
C00006 00004 MOVE A,LINN
C00007 00005 MOVEM A,LINN
C00012 00006 EINIT: SKIPE EINITD
C00014 00007 LINED:
C00017 00008 LFEND: SKIPN NEEDLF check if last line had lf
C00019 00009 DISP1: MOVEI C,0
C00022 00010 RCHNW: MOVE C,[700,,WRD-1]
C00024 00011 APNT: (A). RH GETS CLOBBERED AT SETPR2 TIME
C00026 ENDMK
C⊗;
TITLE PPK
A←1
B←2
C←3
D←4
E←5
f←6
ppos← 7
pnt←10
len←11
NLFS←12
col←13
DAT←14
CB←T←15
TT←16
P←17
LPDL←←69
BFSZ←←10000
SYSTOP←←265
CHKBEG←←223
LEBUF←←330 ;Displacement of actual line editor buffer from beginning of dpy hdr
LINK←←65 ;displacement in PP of link to next PP (DPYSER)
MAXWIN←←=33
WTXTSZ←←MAXWIN*=100/5
CDPYBS: 2450 ;value of DPYBSZ (from E) ***09/13/77 00:15--NOT USED***
ADPYBU: 1236 ;address of DPYBUF (from E) ***09/13/77 00:15--NOT USED***
AWINLI: 0;13217 ;address of WINLIN (from E)
ABOTST: 0;4123 ;address of BOTSTR (from E)
AHEDBL: 0;13223 ;address of HEDBLK (from E)
ATRLBL: 0;13222 ;address of TRLBLK (from E)
resstr: 4000,,520 ;<break>P
4000,,127 ;<esc>W
respag: resstr-.,,resstr
; 08/14/78 EJG *** bug below has supposedly been fixed ***
; 07/05/78 EJG - someday fix to do tabs right - bug e.g. PPKing on a DSKSIZ on DM
START:
SETZ B,
CALLI B,400062
CALLI A,24
HRRZ A,A
MOVEM A,TESTXX#
CAIE A,=154279
CAIN A,=199526
CAIA
CAIN A,=166957
MOVN B,[=30337167360]
CALLI B,43
MOVE C,[-1,,[015000,,D]]
TTYSET C, ;get display height in D
SUBI D,2 ;-2 for who line
MOVEM D,DPYHT
SETZM EMODE
SETOM LINN
BEG: MOVE P,[-LPDL,,PDL]
MOVEI A,LEBUF
PEEK A,
MOVEM A,DLEBUF ;Displacement of editor buffer from dpy hdr addr
MOVEI A,CHKBEG
PEEK A,
MOVEM A,CCHKBEG
LSH A,-9 ;# LO PIECE PAGES
MOVEI B,SYSTOP
PEEK B,
PEEK B,
MOVE C,CCHKBEG
SUB C,B
MOVEM C,CBMST ;CHKBEG-SYSTOP
LSH B,-9+5 ;STARTING HI PIECE PAGE # * 40
ADDI B,10 ;SET 2-PIECE FLAG
HRL B,A
MOVEM B,XGETHI
GETHI B,
JRST 4,.
MOVE A,400321
HLRZM A,TBLKPT
HRRZM A,TPJMP
MOVE A,400322
HRRZM A,PPCALL
MOVE A,400236
MOVEM A,JBTLIN
MOVE A,400237 ;GET POINTER TO LETAB ENTRY OF FIRST III
MOVEM A,LETAB
LDB A,[POINT 9,400221,8] ;GET SCNNUM (NUMBER OF TTYS), WHICH IS ALSO
MOVEM A,DPYL0# ; THE NUMBER OF THE FIRST III
MOVE A,LINN
JUMPGE A,BEG2
OUTSTR [ASCIZ/Line? /]
NXCH: INCHWL A
HACH: CAIN A,175
JRST [ EXIT 1,↔ JRST START ]
CAIN A,15
JRST [ INCHWL
EXIT 1,
JRST START]
CAIE A,11
CAIN A,40
JRST NXCH
SUBI A,60
REELUP: INCHWL C
CAIN C,15
JRST [INCHRW T
JRST BEG3A]
LSH A,3
ADDI A,-"0"(C)
JRST REELUP
BEG3A: push p,a
push p,b
lsh a,9 ;type <brk> <line number> W
add a,[4000,,727]
hrroi b,a
ttyset b,
pop p,b
pop p,a
MOVEM A,LINN
BEG2: ADD A,LETAB ;ADD POINTER TO FIRST III'S LETAB ENTRY
SUB A,DPYL0
MOVEI B,400000(A)
MOVEM B,LEENT
HRRZ A,400000(A)
JUMPE A,[ OUTSTR [ASCIZ/Not in use or not a display.
/]
JRST START]
MOVE T,CBMST
ADDI T,400000
HRRM T,APNT
SUBI T,2
HRLI T,-20
MOVSM T,JMPOFF
ADD A,PPCALL
HLRZ A,@APNT
SKIPN EMODE
JRST NEMODE
MOVE B,A
ADDI A,LINK ;go to secondary PP if E mode
HRRZ A,@APNT
SKIPN A ;but not if there isn't one
MOVE A,B
NEMODE: MOVEI B,1(A)
ADD B,TPJMP
HRLM B,ENDTST
ADD A,TBLKPT
HRRZ A,@APNT
ADD A,APNT
HRLI A,444400
MOVEM A,DLISTL
SETZM CCNT
SETZM MAYTAB
MOVNI A,69
MOVEM A,BLKCNT
SKIPN EMODE
JRST NEMOD2
PUSHJ P,EINIT
JRST NEMOD2 ;EINIT failed
MOVEI A,B
MOVE B,LINN
TTYJOB B,
HRRO C,AWINLI
MOVEI D,WINLIN
JOBRD A,
JRST NEMOD2
MOVE C,WINLIN
MOVEM C,ANXTLN
MOVE C,[WINBLK,,WINBLK+1]
SETZM -1(C)
BLT C,WINBLK+MAXWIN-1
MOVE E,[-MAXWIN-1,,WINBLK-1] ;pointer list
MOVE F,[-WTXTSZ+40,,WINTXT] ;text storage
HRRO C,AHEDBL
MOVEI D,HEDBLK
JOBRD A,
JRST NEMOD2
HRRO C,ATRLBL
MOVEI D,TRLBLK
JOBRD A,
JRST NEMOD2
MOVE C,HEDBLK
ADD C,[-40,,-1]
HRRZ D,F
JOBRD A,
JRST NEMOD2
HRRZ C,(F) ;total wdcount
ADDI C,-2(F) ;last text wd
HRLZ C,C ;to LH
HRRI C,4(F) ;first text wd
MOVEM C,DLHED
HRRZ C,(F) ;total wdcount
HRL C,C ;in both halves
ADD F,C ;update textptr
SETZM -1(F) ;Sigh. To stop text group.
MOVE C,TRLBLK
ADD C,[-40,,-1]
HRRZ D,F
JOBRD A,
JRST NEMOD2
HRRZ C,(F) ;total wdcount
ADDI C,-2(F) ;last text wd
HRLZ C,C ;to LH
HRRI C,4(F) ;first text wd
MOVEM C,DLTRL
HRRZ C,(F) ;total wdcount
HRL C,C ;in both halves
ADD F,C ;update textptr
SETZM -1(F) ;Sigh. To stop text group.
EWINLP: MOVE C,ANXTLN
CAMN C,ABOTST
JRST EWINDN ;finished (bottom of page)
AOBJP E,EWINDN;finished (MAXWIN lines done)
JUMPGE F,EWINDN;out of space (in text area)
ADD C,[-40,,-1]
HRRZ D,F
JOBRD A,
JRST NEMOD2
HRRZ C,1(F)
MOVEM C,ANXTLN
HRRZ C,(F) ;total wdcount
ADDI C,-2(F) ;last text wd
SKIPGE 3(F)
SUBI C,3 ;correct last wd adr if page mark line
HRLZ C,C ;to LH
HRRI C,4(F) ;first text wd
MOVEM C,(E)
HRRZ C,(F) ;total wdcount
CAILE C,100
JRST NEMOD2
HRL C,C ;in both halves
ADD F,C ;update textptr
SETZM -1(F) ;Sigh. To stop text group.
JRST EWINLP
EWINDN:
MOVEI A,DLIST
CAIA
NEMOD2: MOVEI A,DLISTL
MOVEM A,DLISTP
HRRZ A,(A)
HRLI A,444400
MOVEM A,WRDP
MOVEI F,0
MOVEI NLFS,0
MOVEI LEN,0
MOVE PNT,[POINT 7,PPAGE+2]
LF0: MOVEI COL,0
LF1: PUSHJ P,RCH
JRST LINED
CAIN C,12
JUMPE F,[ MOVEI C,40
IDPB C,PNT
MOVEI C,15
IDPB C,PNT
MOVEI C,12
IDPB C,PNT
ADDI LEN,3
ADDI NLFS,1
JRST LF0]
MOVE F,C
SUBI F,12
IDPB C,PNT
CAIN C,12
JRST [ADDI NLFS,1
AOJA LEN,LF0]
CAIN C,11
JRST LTAB
ADDI COL,1
AOJA LEN,LF1
LTAB: MOVEI C,40
IDPB C,PNT
ADDI LEN,1
ADDI COL,1
TRNE COL,7
JRST LTAB
AOJA LEN,LF1
EINIT: SKIPE EINITD
JRST CPOPJ1
MOVE B,LINN
TTYJOB B,
JUMPLE B,CPOPJ
SEGNUM B,
JUMPE B,CPOPJ
DETSEG 0,
PUSH P,[EINRET] ;set exit to re-do GETHI
ATTSEG B,
POPJ P,
MOVE A,400011 ;addr(BOTSTR)
HRRZM A,ABOTST
MOVE A,400016 ;addr(DRAW)
MOVE A,3(A) ;DRAW+3: JRST DRAWM
HLRZ B,A
CAIE B,(<JRST>)
POPJ P,
MOVE A,0(A) ;DRAWM: PUSHJ P,DISP0
HLRZ B,A
CAIE B,(<PUSHJ 17,>)
POPJ P,
MOVE A,4(A) ;DISP0+4: PUSHJ P,WINCHK
HLRZ B,A
CAIE B,(<PUSHJ 17,>)
POPJ P,
MOVE C,A ;save PUSHJ P,WINCHK
MOVE A,-12(A) ;WINCHK-12: MOVEM T,WINLIN#
HLRZ B,A
CAIE B,(<MOVEM 15,>)
POPJ P,
HRRZM A,AWINLI
MOVE A,2(C) ;WINCHK+2: JRST CENWIN
HLRZ B,A
CAIE B,(<JRST>)
POPJ P,
MOVE A,3(A) ;CENWIN+3: AOJA A,SETWIN
HLRZ B,A
CAIE B,(<AOJA 1,>)
POPJ P,
MOVE C,A ;save AOJA A,SETWIN
MOVE A,6(A) ;SETWIN+6: MOVEM B,HEDBLK#
HLRZ B,A
CAIE B,(<MOVEM 2,>)
POPJ P,
HRRZM A,AHEDBL
MOVE A,12(C) ;SETWIN+12: MOVEM B,TRLBLK#
HLRZ B,A
CAIE B,(<MOVEM 2,>)
POPJ P,
HRRZM A,ATRLBL
SETOM EINITD
JRST CPOPJ1
EINRET: CAIA
AOS (P)
MOVE A,XGETHI
GETHI A,
HALT .
POPJ P,
LINED:
MOVEM F,NEEDLF#
MOVE DAT,@LEENT ; append line editor
SKIPN DAT
JRST LFEND
ADD DAT,DLEBUF ;Point to buffer itself
HRRZ CB,CCHKBEG ;BREAK IN NON-SHUFFLING SYSTEM
CAIGE CB,(DAT) ;PAST BREAK IN SYSTEM?
ADD DAT,CBMST ;ADD CHKBEG-SYSTOP
ADDI DAT,400000 ;I CONTAINS RELOCATION OF SYSTEM
MOVE F,DAT ;Make copy of pointer for depositing
MOVEI A,1
LIE: TDNE A,(DAT) ;Is this a text word?
AOJA DAT,LIE ;Yes
CNTDN: CAMN F,DAT
JRST LFEND ;Empty line editor
HRLI F,440700
SUBI DAT,1 ;Point to last real text word in buffer
HRLI DAT,100700 ;Byte pointer to char before EOLCHR in buffer
MOVEM LEN,SAVLEN# ;in case LE ends with crlf(ie its been sent),
MOVEM PNT,SAVPNT# ;save len and pnt so we can back up
LECS: CAMN F,DAT ;check if end overstepped
JRST LFOO
ILDB C,F
CAIE C,177
CAIN C,14 ;stop on funny characters
JRST LFOO
CAIE C,13
CAIN C,0
JRST LFOO
CAIE C,15 ;if line ends in <cr> or <lf>
CAIN C,12 ;its already been sent, dont dpy it
JRST BACKUP
CAIN C,175
JRST BACKUP
IDPB C,PNT ;normally, deposit
AOJA LEN,LECS ;and account
LFOO: SETOM NEEDLF ;we didn't insert crlf
JRST LFEND
BACKUP: SKIPN EMODE ;if E mode, don't ever flush line editor
JRST BACKPU
CAIE C,12
SETOM NEEDLF
JRST LFEND
BACKPU: MOVE PNT,SAVPNT ;restore depositing byte pntr
MOVE LEN,SAVLEN ;and character cnt
LFEND: SKIPN NEEDLF ;check if last line had lf
JRST LFDONE ;if so, don't add extra one
MOVEI C,40
IDPB C,PNT ;otherwise add space cr lf
MOVEI C,15
IDPB C,PNT
MOVEI C,12
IDPB C,PNT
ADDI LEN,3
ADDI NLFS,1
LFDONE: SKIPLE DPYHT ;if not a display, type out whole buffer
CAMN NLFS,DPYHT ;if just right number of lines
JRST DISP1 ;display immediately
CAML NLFS,DPYHT ;if too few
JRST SQUISH
SPLOO: MOVEI C,40 ;add blank lines
IDPB C,PNT
MOVEI C,15
IDPB C,PNT
MOVEI C,12
IDPB C,PNT
ADDI LEN,3
ADDI NLFS,1
CAMGE NLFS,DPYHT
JRST SPLOO
JRST DISP1
SQUISH: MOVE A,[POINT 7,PPAGE+2] ;must be too many lines, remove some
SQUASH: ILDB C,A
CAIE C,12
JRST SQUASH
SUBI NLFS,1
CAMLE NLFS,DPYHT
JRST SQUASH
MOVE PNT,[POINT 7,PPAGE+2]
SETZ LEN,
SQUOSH: ILDB C,A
IDPB C,PNT
ADDI LEN,1
CAIE C,12
JRST SQUOSH
SOJG NLFS,SQUOSH
MOVE NLFS,DPYHT
DISP1: MOVEI C,0
REPEAT 10,{IDPB C,PNT}
movei c,6(len) ;find number of words for string
idivi c,5
addi c,3+1
hrrm c,buffpt+1
movni a,1
getlin a ;get type of terminal
TLNE A,40000
JRST [MOVE B,DMAGE ;its a DM
MOVEM B,PPAGE
MOVE B,DMAGE+1
MOVEM B,PPAGE+1
JRST GIOT]
tlne a,20000
JRST [MOVE B,DDAGE ;its a DD
MOVEM B,PPAGE
MOVE B,DDAGE+1
MOVEM B,PPAGE+1
JRST GIOT]
TLNE A,400000
JRST [MOVE B,IIAGE ;its a III
MOVEM B,PPAGE
MOVE B,IIAGE+1
MOVEM B,PPAGE+1
PGACT 400000
DPYPOS -1000
JRST GIOT]
JRST [outstr PPAGE+2 ;not a dd - let outstr handle it.
JRST PRTD]
GIOT: UPGIOT BUFFPT
SETOM PPAGE-1(C) ;set low order bit (DD UPG's clobber it)
PRTD: MOVEI A,1
SLEEP A,
MOVE A,LINN
INCHRS B
JRST BEG
CAIN B,175
JRST ALOU
CAIN B,15
JRST [INCHRW B
ALOU: RESET
move a,respag ;block to reset the page printer
ttyset a,
MOVEI A,1
SLEEP A,
EXIT 1,
JRST START]
MOVE A,TESTXX
CAIN A,=0
JRST PRTDX
CAIE B,"E"
CAIN b,"e"
JRST [SETOM EMODE ;Set E mode
JRST BEG]
CAIE B,"N"
CAIN b,"n"
JRST [SETZM EMODE ;Clear E mode - back to normal
JRST BEG]
PRTDX: MOVE A,B
JRST HACH
RCHNW: MOVE C,[700,,WRD-1]
MOVEM C,CHRP
MOVEI C,5
MOVEM C,CCNT
RCHNW2: ILDB C,WRDP
TRNN C,1
JRST RCHNB
MOVEM C,WRD
RCH: SOSGE CCNT
JRST RCHNW
ILDB C,CHRP
CAMN C,MAYTAB
JRST RCH
JUMPE C,RCH
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
RCHNB: MOVE A,DLISTP
CAIN A,DLISTL
JRST RCHNC ;jump if looking at plain old PP
MOVEI C,11
MOVEM C,MAYTAB ;set to ignore tabs, since E lines are wierd
HLRZ A,(A) ;max WRDP
HLL A,WRDP
CAML A,WRDP
JRST RCHNW2 ;max ≤ WRDP, keep going
AOS A,DLISTP
CAIN A,DLISTL
SETZM MAYTAB ;reset to allow tabs if back to plain PP
HRRZ A,(A)
JUMPE A,RCHNB ;skip zero entries
HRLI A,444400
MOVEM A,WRDP
JRST RCHNW2
RCHNC: CAMN C,ENDTST
POPJ P,
ADD C,JMPOFF
TRNN C,-1
AOSLE BLKCNT
POPJ P,
HLRM C,WRDP
JRST RCHNW2
APNT: (A). ;RH GETS CLOBBERED AT SETPR2 TIME
WRD: 0↔-1
ENDTST: 20
IBUF: BLOCK 3
OBUF: BLOCK 3
ENTR: BLOCK 4
FILE: BLOCK 4
PDL: BLOCK LPDL
EXIT 1,
JBTLIN: 0
LETAB: 0
PPCALL: 0
TPJMP: 0
TBLKPT: 0
DPYHT: 0
LINN: 0
CHRP: 0
BLKCNT: 0
CCNT: 0
MAYTAB: 0
WRDP: 0
JMPOFF: 0
LEENT: 0
CBMST: 0
DLEBUF: 0
XGETHI: 0
CCHKBEG: 0
EMODE: 0 ;nozero if in E mode
EINITD: 0
DLISTP: 0
DLIST:
DLHED: 0 ;for E window header
WINBLK: BLOCK MAXWIN ;for E window lines
DLTRL: 0 ;for E window trailer
DLISTL: 0 ;for PP
; XDPYBU+DPYBSZ-1,,XDPYBU ;for E body
WINLIN: 0
HEDBLK: 0
TRLBLK: 0
ANXTLN: 0
buffpt: 200000,,PPAGE ;double field mode
0
0
PPAGE+1
ersbuf: BYTE (8) 17,0,46 (3) 1,2,1,4 ;funct. code, chan select, funct. code
0
erspt: ersbuf
erspt-ersbuf
0
0
DDAGE: BYTE (8) 46,0,46 (3) 1,2,1,4
BYTE (8) 2,1,10 (3)3,4,5,4
DMAGE: BYTE (7) 177,30,177,30,177
BYTE (7) 30,177,14,140,142
IIAGE: BYTE (11) -1000,700 (3) 0,0 (1) 0,1 (2) 2 (4) 6
BYTE (11) -1000,700 (3) 0,0 (1) 0,1 (2) 2 (4) 6
PPAGE: BYTE (8) 46,0,46 (3) 1,2,1,4
BYTE (8) 2,1,10 (3)3,4,5,4
REPEAT BFSZ,{1}
WINTXT: BLOCK WTXTSZ
END START